KindLabs Model: KindEMR Data Only

Aneuploidy prediction model based on KindEMR data from fresh IVF in autologous eggs, using age at retrieval and other factors

source("load_data.R")

library(ggtext)
library(patchwork)
kb_theme_set()

Functions from other published aneuploidy prediction models:

Franasiak et al. 2014: Percent aneuploid = 1,965 − 278.9 * Age + 16.41 * (Age)^2 − 0.4922 * (Age)^3 + 0.007451 * (Age)^4 − 0.000044692 * (Age)^5

McCoy et al. 2015 (Natera data): Log-odds aneuploid = 4.846 - 0.416 * Maternal age + 0.00755 * (Maternal age)^2

franasiak_aneuploidy <- function(age) {
  percent_value <- 1965 -
                   278.9 * age +
                   16.41 * (age^2) -
                   0.4922 * (age^3) +
                   0.007451 * (age^4) -
                   0.000044692 * (age^5)
  return(percent_value / 100) # Convert to proportion (0-1 scale)
}

natera_aneuploidy <- function(age) {
  log_odds_value <- 4.846 - 0.416 * age + 0.00755 * (age^2)
  return(exp(log_odds_value) / (1 + exp(log_odds_value))) # Convert log-odds to probability
}

Predict aneuploidy rate based on patient age at retrieval

kb %>% 
  filter(is.na(pgta_euploid) | is.na(pgta_aneuploid)) %>% view

rates_by_age <- kb %>%
  mutate(patient_age_year_at_retrieval = floor(patient_age_at_retrieval)) %>%
  filter(patient_age_year_at_retrieval %>% between(15, 50)) %>%
  filter(!is.na(pgta_aneuploid)) %>%
  group_by(patient_age_year_at_retrieval) %>%
  summarise(
    pgta_euploid_rate = mean(as.numeric(pgta_euploid), na.rm = TRUE),
    pgta_euploid_total = sum(as.numeric(pgta_euploid), na.rm = TRUE),
    pgta_aneuploid_rate = mean(as.numeric(pgta_aneuploid), na.rm = TRUE),
    pgta_aneuploid_total = sum(as.numeric(pgta_aneuploid), na.rm = TRUE),
    pgta_aneuploid_segmental_rate = mean(as.numeric(pgta_aneuploid_segmental), na.rm = TRUE),
    pgta_aneuploid_segmental_total = sum(as.numeric(pgta_aneuploid_segmental), na.rm = TRUE),
    pgta_triploid_rate = mean(as.numeric(pgta_triploid), na.rm = TRUE),
    pgta_triploid_total = sum(as.numeric(pgta_triploid), na.rm = TRUE),
    pgta_mosaic_rate = mean(as.numeric(pgta_mosaic), na.rm = TRUE),
    pgta_mosaic_total = sum(as.numeric(pgta_mosaic), na.rm = TRUE),
    pgta_mosaic_whole_chromosome_rate = mean(as.numeric(pgta_mosaic_whole_chromosome), na.rm = TRUE),
    pgta_mosaic_whole_chromosome_total = sum(as.numeric(pgta_mosaic_whole_chromosome), na.rm = TRUE),
    pgta_mosaic_segmental_rate = mean(as.numeric(pgta_mosaic_segmental), na.rm = TRUE),
    pgta_mosaic_segmental_total = sum(as.numeric(pgta_mosaic_segmental), na.rm = TRUE),
    pgta_mosaic_low_rate = mean(as.numeric(pgta_mosaic_low), na.rm = TRUE),
    pgta_mosaic_low_total = sum(as.numeric(pgta_mosaic_low), na.rm = TRUE),
    pgta_mosaic_high_rate = mean(as.numeric(pgta_mosaic_high), na.rm = TRUE),
    pgta_mosaic_high_total = sum(as.numeric(pgta_mosaic_high), na.rm = TRUE),
    pgta_no_dna_detected_rate = mean(as.numeric(pgta_no_dna_detected), na.rm = TRUE),
    pgta_no_dna_detected_total = sum(as.numeric(pgta_no_dna_detected), na.rm = TRUE),
    pgta_no_result_rate = mean(as.numeric(pgta_no_result), na.rm = TRUE),
    pgta_no_result_total = sum(as.numeric(pgta_no_result), na.rm = TRUE),
    pgta_clinical_results_undetermined_rate = mean(as.numeric(pgta_clinical_results_undetermined), na.rm = TRUE),
    pgta_clinical_results_undetermined_total = sum(as.numeric(pgta_clinical_results_undetermined), na.rm = TRUE),
    pgta_inconclusive_rate = mean(as.numeric(pgta_inconclusive), na.rm = TRUE),
    pgta_inconclusive_total = sum(as.numeric(pgta_inconclusive), na.rm = TRUE),
    n = n()
  )

# total n
rates_by_age_n <- kb %>%
  mutate(patient_age_year_at_retrieval = floor(patient_age_at_retrieval)) %>%
  filter(patient_age_year_at_retrieval %>% between(15, 50)) %>%
  filter(!is.na(pgta_aneuploid)) %>%
  summarize(
    n = n(),
    distinct_attempts = n_distinct(attempt_id),
    distinct_patients = n_distinct(patient_id)
  )

No apparent effect of biopsy day or patient age on no call rate